Projet3

Amaury BODIN et Vincent BERNARD

Résumé : Le jeu de données contient des informations sur les thèses de doctorat françaises, en mettant l’accent sur la similarité sémantique. Cela représente un défi unique pour la classification en raison de la nature textuelle et sémantique des données. Objectif principal : Mettre en place une classification bayésienne avancée avec analyse discriminante sur un jeu de données de résumés de thèses de doctorat françaises afin de les catégoriser en domaines d’étude. Source des données : Recherche de similarité sémantique de thèse de doctorat française à partir de Kaggle.

On nettoie l’environnement pour repartir sur des bases saines et ne pas avoir trop d’espace pris en mémoire.

rm(list = ls())

#install.packages(c("kableExtra", "e1071", "ggplot2", "dplyr"))

On importe le package kableExtra pour avoir une belle manière, une manière uniforme de présenter les tableaux dans ce RMarkdown.

On utilisera le package ‘e1071’ pour avoir accès à des fonctions de classification bayesienne.

On importe le package ggplot, au cas où on aurait besoin d’afficher des données, des graphes dans ce rapport.

On importe égalemnt le package dplyr car il fourni des fonctions qui permettent de manipuler les données efficacement.

library(kableExtra)  
library('e1071')
library(ggplot2)
library(dplyr)

1 - Chargement des données de Kaggle

On importe les données du dataset que l’on va utiliser puis on regarde à quoi ressemble le dataset que nous allons utiliser.

Ci-dessous, on peut voir que le dataset possède 7 colonnes.

data <- read.csv("french_thesis_20231021_metadata.csv")
colnames(data)

## [1] "URL"         "Title"       "Author"      "Description" "Direction"   "Domain"      "Statuts"     "Date"

data %>%
  head() %>%
  kbl() %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE,
                position = "center")

URL	Title	Author	Description	Direction	Domain	Statuts	Date
1971PAUU3003	Noyaux salins hygroscopiques et sursaturation saline	Anne-Marie Delage		[(‘Camille Lafargue’, ‘067206956’)]	Physique. Thermodynamique	Soutenue	1971-01-01
1972PAUU3002	Contribution à l’étude de l’évolution des propriétés diélectriques d’échantillons obtenus par solidification de solutions aqueuses de chlorure d’ammonium	René Cazaban-Marque		[(‘Camille Lafargue’, ‘067206956’)]	Physique. Thermodynamique	Soutenue	1972-01-01
1973NAN10113	Lymphocytologie	Domagoj Sabolović	“La lymphocytologie est une discipline de l’immunologie générale. Elle a débuté par la découverte du rôle fondamental du petit lymphocyte dans l’immunité. Son développement a été accéléré par la mise en évidence de deux lignées lymphocytaires distinctes dans la population lymphoïde périphérique : l’une thymo-dépendante et l’autre burso ou moelle osseuse -dépendante. Dans la genèse de la réponse immunitaire normale leurs rôles sont hautement spécialisés et une interaction entre eux assure l’expression complète et contrôle toute manifestation de la personnalité immunologique de l’individu. A la lumière de cette découverte, l’immunologiste d’autrefois est devenu lymphocytologiste pour pouvoir réinterpréter les phénomènes immunitaires comme, la tolérance, l’auto-immunité, l’immunité cellulaire, l’immunité humorale et bien d’autres. Le présent travail se propose d’apporter des méthodes, des expériences et des hypothèses nouvelles pour faciliter cette interprétation. Pour cela, il fait appel à des résultats déjà publiés et à d’autres qui ne le sont point.”	[(’ Directeur de thèse inconnu’, None)]	Sciences naturelles	Soutenue	1973-01-01
1976PAUU3001	Etude théorique des systèmes électroniques à couches ouvertes : application à l’étude photochimique de la cycloaddition du méthylène sur l’éthylène	Marie-Laure de Taffanel		[(‘Alain Dargelos’, ‘060368292’)]	Chimie structurale	Soutenue	1976-01-01
s66414	Le personnel diplomatique francais sous la revolution de 1789 a 1799.	Henri Robert		[(‘Jean Tulard’, ‘027171183’)]	Histoire	En préparation	1976-12-01
1993PA100148	Les miracles de l’Évêque Jean Michel et le culte des saints dans le Diocèse d’Angers v. 1370- v. 1560	Jean-Michel Matz		[(‘André Vauchez’, ‘027178501’)]	Histoire	Soutenue	1979-01-01

On peut voir, ci-dessous que le dataset possède 519 578 lignes, que chaque colonne est de type caracter.

summary(data)

##      URL               Title              Author          Description         Direction            Domain            Statuts         
##  Length:519578      Length:519578      Length:519578      Length:519578      Length:519578      Length:519578      Length:519578     
##  Class :character   Class :character   Class :character   Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##      Date          
##  Length:519578     
##  Class :character  
##  Mode  :character

On va ici, venir combiner le titre, l’auteur et la description ensemble car beaucoup de lignes ou thèses n’ont pas de description. Ce qui devrait aussi nous aider a grouper les thèses qui possèdent le même auteur, car même auteur peut aussi vouloir dire même domaine d’activité et de recherche.

data$Extended_Description <- paste(data$Title, data$Author, sep = " ")

Ou alors on peut venir chercher la description complète du projet sur internet via l’url mais dans la plupart des cas l’url n’apporte pas plus d’information.

#data['Description'].fillna('', inplace=True)
#data['URL'] = "https://www.theses.fr/" + data['URL']

data %>%
  head() %>%
  kbl() %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE,
                position = "center")

URL	Title	Author	Description	Direction	Domain	Statuts	Date	Extended_Description
1971PAUU3003	Noyaux salins hygroscopiques et sursaturation saline	Anne-Marie Delage		[(‘Camille Lafargue’, ‘067206956’)]	Physique. Thermodynamique	Soutenue	1971-01-01	Noyaux salins hygroscopiques et sursaturation saline Anne-Marie Delage
1972PAUU3002	Contribution à l’étude de l’évolution des propriétés diélectriques d’échantillons obtenus par solidification de solutions aqueuses de chlorure d’ammonium	René Cazaban-Marque		[(‘Camille Lafargue’, ‘067206956’)]	Physique. Thermodynamique	Soutenue	1972-01-01	Contribution à l’étude de l’évolution des propriétés diélectriques d’échantillons obtenus par solidification de solutions aqueuses de chlorure d’ammonium René Cazaban-Marque
1973NAN10113	Lymphocytologie	Domagoj Sabolović	“La lymphocytologie est une discipline de l’immunologie générale. Elle a débuté par la découverte du rôle fondamental du petit lymphocyte dans l’immunité. Son développement a été accéléré par la mise en évidence de deux lignées lymphocytaires distinctes dans la population lymphoïde périphérique : l’une thymo-dépendante et l’autre burso ou moelle osseuse -dépendante. Dans la genèse de la réponse immunitaire normale leurs rôles sont hautement spécialisés et une interaction entre eux assure l’expression complète et contrôle toute manifestation de la personnalité immunologique de l’individu. A la lumière de cette découverte, l’immunologiste d’autrefois est devenu lymphocytologiste pour pouvoir réinterpréter les phénomènes immunitaires comme, la tolérance, l’auto-immunité, l’immunité cellulaire, l’immunité humorale et bien d’autres. Le présent travail se propose d’apporter des méthodes, des expériences et des hypothèses nouvelles pour faciliter cette interprétation. Pour cela, il fait appel à des résultats déjà publiés et à d’autres qui ne le sont point.”	[(’ Directeur de thèse inconnu’, None)]	Sciences naturelles	Soutenue	1973-01-01	Lymphocytologie Domagoj Sabolović
1976PAUU3001	Etude théorique des systèmes électroniques à couches ouvertes : application à l’étude photochimique de la cycloaddition du méthylène sur l’éthylène	Marie-Laure de Taffanel		[(‘Alain Dargelos’, ‘060368292’)]	Chimie structurale	Soutenue	1976-01-01	Etude théorique des systèmes électroniques à couches ouvertes : application à l’étude photochimique de la cycloaddition du méthylène sur l’éthylène Marie-Laure de Taffanel
s66414	Le personnel diplomatique francais sous la revolution de 1789 a 1799.	Henri Robert		[(‘Jean Tulard’, ‘027171183’)]	Histoire	En préparation	1976-12-01	Le personnel diplomatique francais sous la revolution de 1789 a 1799. Henri Robert
1993PA100148	Les miracles de l’Évêque Jean Michel et le culte des saints dans le Diocèse d’Angers v. 1370- v. 1560	Jean-Michel Matz		[(‘André Vauchez’, ‘027178501’)]	Histoire	Soutenue	1979-01-01	Les miracles de l’Évêque Jean Michel et le culte des saints dans le Diocèse d’Angers v. 1370- v. 1560 Jean-Michel Matz

Pré-traitement des données :

Il faut installer ces packages s’ils ne sont pas déjà présents sur la machine.

# install.packages(c("tm", "SnowballC", "stringr", "quanteda"))

On importe tm car il est utile pour le traitement des données tecxtuelles. On l’utilise en général pour le prétraitement de texte comme la tokenisation, la lemmisation ou encore la création de corpus de textes.

SnowballC donne des outils de stemming pour réduire un mot en sa racine.

stringr est très utilisé pour faire des manipulations de chaines de caractères. Extraire des motifs (patterns) dans une chaine de charactères, et tout autres types de manipulations de chaines de charactères.

quanteta, a été créée pour l’analyse de données de textes.

On a trouvé ces ces libraries sur internet en cherchant des moyen de faire ce qu’on souhaitait.

#install.packages("tm")

library(tm)
library(SnowballC)
library(stringr)
library(quanteda)

On va venir ici réduire la taille de notre jeu de donnée car les ordinateurs portables n’ont souvent que 156 Go de ram et surtout même si la ram n’était pas un problème devoir attendre plusieurs heures à chaque étape le temps que toutes les données soient prisent en compte n’est pas concevable. C’est pour cela que l’on a choisit un petit nombre au début, que l’on puisse faire nos tests et voir si notre code fonctionnait assez rapidement.

set.seed(123)
indices_echantillon = sample(nrow(data), size = 15000) 
data_echantillon = data[indices_echantillon, ]

Avant de commencer on va vérifier que les Domaines sont utilisables pour la prédiction. Malheuresement, on voit que pour l’échantillion séléctionné il y a trop de domaine différent par rapport au nombre de ligne, il risque donc d’être très dur de faire des regroupements et de trouver des points communs aux valeurs.

length(unique(data_echantillon$Domain))

## [1] 3192

#data_echantillon$Domain <- sapply(data_echantillon$Domain, preprocess)
#length(unique(data_echantillon$Domain))

Même en essayant d’appliquer des méthodes pour nettoyer les domaines, il reste tout de même un trop grand nombre de domaines différent par rapport aux nombres de ligne utilisées.

Le code prèsent en dessous trouve les 10 domaines les plus présents dans la colonne Domaine du dataframe_echantillon. Ensuite, on crée donc un nouveau dataframe dans lequel on met les “lignes” associées à ces 10 domaines.

On visualise par ailleurs les 10 domaines les plus présentes dans notre situation.

top10 <- data_echantillon %>%
  count(Domain) %>%
  arrange(desc(n)) %>%
  slice(1:10) %>%
  pull(Domain)

print(top10)

##  [1] "Médecine"                                                      "Informatique"                                                 
##  [3] "Physique"                                                      "Chimie"                                                       
##  [5] "Histoire"                                                      "Sciences économiques"                                         
##  [7] "Sciences appliquées"                                           "Sciences biologiques et fondamentales appliquées. Psychologie"
##  [9] "Psychologie"                                                   "Droit public"

df1 <- data_echantillon %>%
  filter(Domain %in% top10)

df1 %>%
  head() %>%
  kbl() %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE,
                position = "center")

URL	Title	Author	Description	Direction	Domain	Statuts	Date	Extended_Description
s352108	Le provisoire en droit international public	Nathan Pelletier		[(‘Guillaume Le floch’, None)]	Droit public	En préparation	2022-10-25	Le provisoire en droit international public Nathan Pelletier
1991TOU31510	Etude par resonance magnetique nucleaire du proton, du muscle squelettique dans la broncho-pneumopathie chronique obstructive : a propos de 38 observations	MICHEL SOULIER		[(‘Michel Krempf’, ‘029291593’)]	Médecine	Soutenue	1991-01-01	Etude par resonance magnetique nucleaire du proton, du muscle squelettique dans la broncho-pneumopathie chronique obstructive : a propos de 38 observations MICHEL SOULIER
2002NICE5794	Contribution à la programmation générative : application dans le générateur SmartTools, technologies XML, programmation par aspects et composants	Carine Courbis	Avec l’émergence d’Internet et la prolifération de nouvelles technologies, la conception et le développement d’applications complexes doivent impérativement prendre en compte les standards et les aspects de répartition, déploiement et réutilisation du code. Cette thèse jette les bases d’une nouvelle manière de programmer où ces facettes sont automatiquement intégrées aux spécifications de l’application lors de phases de génération de code source. L’intérêt de cette approche est de bien séparer la logique métier des aspects non fonctionnels (les technologies), simplifiant l’écriture du code. Une nouvelle programmation, dite générative, est proposée s’appuyant sur les technologies XML, les technologies objets, la programmation par aspects, les patrons de conception, et la programmation par composants. Cette approche a été appliquée, à différents niveaux, lors de la réalisation d’un atelier logiciel pour les langages métiers.	[(‘Didier Parigot’, ‘029236207’), (‘Isabelle Attali’, ‘06044942X’)]	Informatique	Soutenue	2002-01-01	Contribution à la programmation générative : application dans le générateur SmartTools, technologies XML, programmation par aspects et composants Carine Courbis
1998TOU30026	Vers une theorie de l’auto-organisation dans les systemes multi-agents basee sur la cooperation : application a la recherche d’information dans un systeme d’information repartie	Valérie Camps	Les techniques multi-agents permettent de construire des systemes artificiels dans lesquels l’activite collective observee n’est decrite dans aucune de leurs parties. Cette approche est particulierement utile dans les applications ou la cooperation d’une multitude de taches elementaires est indispensable pour la realisation d’une activite collective precise mais difficilement formalisable, lorsque le systeme est fortement evolutif ou encore lorsque l’environnement exerce des contraintes fortes et dynamiques sur le systeme. Pour aboutir a un comportement collectif coherent alors que les agents ne cherchent a atteindre qu’un objectif individuel, la propriete suivante a ete demontree : pour tout systeme fonctionnellement adequat, il est possible de trouver au moins un systeme a milieu interieur cooperatif qui lui soit equivalent, c’est-a-dire un systeme dont toutes les parties entretiennent des relations cooperatives entre elles et avec l’environnement du systeme. Cette propriete conduit a une nouvelle methode de conception de systemes. En effet, il ne devient plus necessaire de connaitre la finalite d’un systeme mais de savoir que tous les elements qui le constituent doivent cooperer. Des qu’une situation non cooperative survient, le systeme doit s’auto-organiser afin de revenir a un etat cooperatif. La tache du concepteur d’une application consiste alors a identifier les situations non cooperatives auxquelles peuvent etre confrontes les elements du systeme puis a definir les traitements qu’ils doivent effectuer pour revenir a un etat cooperatif conformement a la theorie presentee. Ces principes ont ete appliques au projet arcadia, dans le cadre d’un contrat cnet realise en collaboration avec l’onera-cert. Son but est de permettre d’acceder a de l’information pertinente dans un reseau de ressources d’informations distribuees, heterogenes et en constante evolution. Des exemples de fonctionnement du prototype realise sont analyses.	[(‘Bernard Pavard’, ‘063463512’)]	Sciences appliquées	Soutenue	1998-01-01	Vers une theorie de l’auto-organisation dans les systemes multi-agents basee sur la cooperation : application a la recherche d’information dans un systeme d’information repartie Valérie Camps
2005GRE10162	Mgb2 : le supraconducteur à 2 GAPS	Laurence Lyard	MgB2 est un composé supraconducteur conventionnel et exotique : conventionnel dans son couplage électron-phonon, exotique dans la présence de deux gaps supraconducteurs faiblement couplés. Sa récente découverte a engendré un grand nombre de travaux. Mais si un consensus s’est établi rapidement sur sa nature multigap, les valeurs des paramètres de l’état supraconducteur comme les longueurs de cohérence (ξ) et de pénétration (λ) aim que celles des champs critiques inférieur (Hc1) et supérieur (Hc2) restaient controversées. Mon travail de thèse a consisté à déterminer les valeurs de ces paramètres et de leur an isotropie en utilisant deux techniques complémentaires : la magnétométrie à sondes de Hall et la chaleur spécifique alternative. Nous avons ainsi établi le diagramme de phases H- T de MgB2. En mesurant la répartition de l’induction magnétique sur une collection d’échantillons de rapports de dimensions variés, nous avons mis en évidence la présence de barrières géométriques, retardant l’entrée des vortex. Les dépendances de l’anisotropie de Hcl et Hc2 avec la température et celle de λ et ξ avec le champ magnétique ont été établies. Elles sont dues à la présence de deux bandes supraconductrices faiblement couplées et dont l’influence relative varie en fonction de la position dans le diagramme H-T. Enfin, nous avons étudié des échantillons dopés et irradiés. La substitution de Mg par Al modifie la densité électronique et donc les champs critiques. En revanche le désordre ponctuel introduit par l’irradiation aux électrons amplifie le piégeage volumique des vortex. Il augmente brutalement l’effet de pic qui pourrait être révélateur d’une transition ordre-désordre.	[(‘Thierry Klein’, ‘077915488’), (‘Christophe Marcenat’, ‘031343546’)]	Physique	Soutenue	2005-01-01	Mgb2 : le supraconducteur à 2 GAPS Laurence Lyard
1991AMIEM089	L’hospitalisation des adolescents dans un c. H. U	ROBERT RUBINSZTAJN		[(‘Patrick Alvin’, ‘034216847’)]	Médecine	Soutenue	1991-01-01	L’hospitalisation des adolescents dans un c. H. U ROBERT RUBINSZTAJN

On peut donc maintenant partir d’une meilleure base avec des domaines bien plus clair et en moins grand nombre.

Nous pouvons donc passer au pré-traitement de la description allongée que nous avons créée pour, en gardant seulement les éléments important.

La fonction preprocess retire tous les signes de ponctuation d’un texte. On met le texte en minuscule, on retire tous les URLs, on retire les mots vides en francais et en anglais (les mots qui n’ont pas d’importance dans une phrase. Et pour fininr, avant de renvoyer un texte on applique du stemming sur les mots. C’est-à-dire qu’on garde uniquement la racine d’un mot par exemple : ‘running’ deveint ‘run’

preprocess <- function(text) {

  text <- gsub("[[:punct:]]", " ", text)
  text <- tolower(text)
  text <- str_replace_all(text, "http\\S+|www\\S+|https\\S+", "")
  text <- removeWords(text, stopwords("fr"))
  text <- removeWords(text, stopwords("en"))
#stemming avec snowballc
  text <- wordStem(text, language = "french")
  text <- wordStem(text, language = "english")
  
  return(text)
}

On change la colonne Extended_Description en appliquant dessus la fonction qui a été crée juste au dessus.

df1$Extended_Description <- sapply(df1$Extended_Description, preprocess)

On visualise ces changement pour s’assurer qu’ils ont bien été effectués.

df1$Extended_Description %>%
  head() %>%
  kbl() %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE,
                position = "center")

x
provisoire droit international public nathan pelleti
etude resonance magnetique nucleaire proton muscle squelettique broncho pneumopathie chronique obstructive propos 38 observations michel souli
contribution programmation générative application générateur smarttools technologies xml programmation aspects composants carine courb
vers theorie auto organisation systemes multi agents basee cooperation application recherche information systeme information repartie valérie camp
mgb2 supraconducteur 2 gaps laurence lyard
hospitalisation adolescents h u robert rubinsztajn

Vectorisation des données avec la TF-IDF, pour donner une valeur à chaque mot, nous permettant plus tard de savoir leur poids et donc de réaliser une meilleur classification.

On prépare des données textuelles pour les utiliser en apprentissage automatique. Pour cela, on crée une matrice fréquence de documents aussi appellée DFM qui est pondérée par une TF-IDF à partir d’un corpus de texte qu’on crée.

corpus <- corpus(df1, text_field = "Extended_Description")
tokens <- tokens(corpus)
dfm <- dfm(tokens, tolower = TRUE)
dfm_tfidf <- dfm_tfidf(dfm)

data_tf <- as.data.frame(as.matrix(dfm_tfidf))

On visualise maintenant le nouveau dataframe créé.

data_tf %>%
  head() %>%
  kbl() %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE,
                position = "center")

	provisoire	droit	international	public	nathan	pelleti	etude	resonance	magnetique	nucleaire	proton	muscle	squelettique	broncho	pneumopathie	chronique	obstructive	propos	38	observations	michel	souli	contribution	programmation	générative	application	générateur	smarttools	technologies	xml	aspects	composants	carine	courb	vers	theorie	auto	organisation	systemes	multi	agents	basee	cooperation	recherche	information	systeme	repartie	valérie	camp	mgb2	supraconducteur	2	gaps	laurence	lyard	hospitalisation	adolescents	h	u	robert	rubinsztajn
text1	3.087781	1.816715	2.286149	2.22248	3.263873	3.263873	0.0000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000
text2	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.9617583	2.564903	2.61066	2.719805	2.962843	2.962843	3.564903	3.087781	3.263873	2.61066	3.564903	1.232464	2.962843	1.772511	1.952119	3.564903	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000
text3	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.0000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	1.415684	5.129805	3.564903	1.251035	3.263873	3.564903	2.786751	3.087781	2.033424	2.52351	2.962843	3.564903	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000
text4	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.0000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	1.251035	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	1.92145	2.962843	2.719805	2.286149	2.133539	1.962843	2.22248	3.087781	3.263873	1.952119	4.267078	2.133539	3.564903	2.564903	3.564903	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000
text5	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.0000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	3.564903	3.087781	1.962843	3.564903	2.334454	3.564903	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000
text6	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.0000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.00000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	0.000000	2.865933	2.865933	2.184691	2.52351	2.719805	3.564903

On va maintenant venir transformer nos domaines en numérique pour que la variables domaine puissent passer dans les modèles.

df1$Code_domain <- as.numeric(factor(df1$Domain))
data_tf$Code_domain <- df1$Code_domain

Extraction des caractéristiques et modélisation des Rubriques LDA :

On utilise topicmodels car il est utile pour l’analyse de sujets. Il aide à identifier des sujets qui reviennent dans un ensemble de documents. Cette librarie permet d’utiliser des modèles LDA.

La bibliothèque slam nous permet de travailler plus simplement avec des matrices creuses. C’est une librarie qui est apparement très utilisée pour l’analyse de sujets, elle permet des calculs efficaces sur des vecteurs. .

Et la librairie matrice fournit des méthodes qui optimisent le travail et les calculs avec des matrices.

#install.packages(c("topicmodels", "slam", "Matrix"))

library(topicmodels)
library(slam)
library(Matrix)

Ce code utilise le modèle LDA pour découvrir des thèmes dans les résumés de thèses. La ligne lda_model <- LDA(dfm, k = 10) applique l’algorithme LDA avec l’objectif de déterminer 10 sujets distincts. Ensuite, la distribution des sujets pour chaque document est extraite, montrant comment chaque thèse est répartie entre les sujets identifiés. Ces distributions sont ajoutées en tant que nouvelles caractéristiques au dataframe existant (data_tf). Enfin, les termes les plus fréquents associés à chaque sujet sont affichés, fournissant un aperçu des mots clés liés à chaque thème. Ce processus global permet d’explorer et de comprendre les principaux thèmes présents dans les résumés de thèses à l’aide de l’analyse LDA.

On essaie de prendre plus de topics que l’on a de domaine pour que notre modèle plus tard ait une plus grande marge de manoeuvre. Ce que l’on veut dire par là est que si il n’y a que 10 topics et que le même topics est affecté plusieurs fois a deux domaines différents cela peut poser problème lors de l’apprentissage, alors que là avec plus de topics les chances de mauvaise associations de topics à répétitions sont plus basses !

lda_model <- LDA(dfm, k = 20)

distri_rubrique <- as.matrix(topics(lda_model))
data_tf_lda <- cbind(data_tf, distri_rubrique)

terms(lda_model)

##         Topic 1         Topic 2         Topic 3         Topic 4         Topic 5         Topic 6         Topic 7         Topic 8 
##         "droit"         "étude"          "rôle"         "essai"         "cours" "développement"           "non"         "etude" 
##         Topic 9        Topic 10        Topic 11        Topic 12        Topic 13        Topic 14        Topic 15        Topic 16 
##   "application"         "etude"  "interactions"       "service"       "thierry"       "données"         "etude"         "homme" 
##        Topic 17        Topic 18        Topic 19        Topic 20 
##        "pierre"         "etude"        "propos"             "2"

Cette tentative de regroupement nous permet d’avoir une variable en plus pour prédire a quel domain appartient chaque description et donc chaque thèse.

#install.packages(c("MASS", "caret"))

La librairie MASS donne accès à de nombreuses fonctions statistiques et méthodes d’ajustement de modèles. Régression Linéaire, analyse discriminante, analyse de variance, …

Caret (classification and regression training) est une librairei qui permet de faire de la création, comparaison et évaluation de modèles de classification et de régression.

library(MASS)
library(caret)

Avant cela on va venir enlever les variables dont les valeurs de la colonnes sont uniques, donc celle qui ne présentent pas de variabilités. Ceci devrait nous permettre de réduire la dimensionalité de notre dataset et donc sûrement améliorer la précision de notre modèle LDA.

data_tf_lda <-data_tf_lda[sapply(data_tf_lda, function(x) length(unique(x))) > 2]

On va maintenant pouvoir passer à la création du model LDA, mais avant cela on doit ajouter la colonne Code_Domain à data_tf_lda car c’est la colonne que l’on va devoir prédire

data_tf_lda$Code_domain <- df1$Code_domain

On vient maintenant faire le modèle et ajouter les prédictions dans un dataframe qui sera lui utiliser pour faire les prédictions finale à l’aide d’un modèle Bayésien.

reduc_lda_model <- lda(Code_domain ~ ., data = data_tf_lda)

## Warning in lda.default(x, grouping, ...): les variables sont colinéaires

lda_scores <- predict(reduc_lda_model)$x
df_for_bayes <- cbind(data_tf_lda,lda_scores)
summary(lda_model)

##  Length   Class    Mode 
##       1 LDA_VEM      S4

On va maintenant faire le modèle bayésien en séparant notre jeux de données pour pouvoir faire des entrainement puis faire les tests.

train_index <- sample(seq_len(nrow(df_for_bayes)), 0.8 * nrow(df_for_bayes))
train_data <- df_for_bayes[train_index, ]
test_data <- df_for_bayes[-train_index, ]

train_data <- train_data[, (ncol(train_data) - 10):ncol(train_data)]
test_data <- test_data[, (ncol(test_data) - 10):ncol(test_data)]

train_data$Code_domain <- as.factor(train_data$Code_domain)
test_data$Code_domain <- as.factor(test_data$Code_domain)

Ici, on utilise le modèle NaiveBayes pour entrainer un modèle sur notre dataset d’entrainement.

Ensuite, à l’aide de ce modèle on fait la sur les données de test.

bayes_model <- naiveBayes(Code_domain ~ ., data = train_data)
predictions <- predict(bayes_model, newdata = test_data)

On va maintenant faire une première évaluation du modèle. On affiche la matrice de confusion :

confusion_matrix <- table(predictions, test_data$Code_domain)
accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)

confusion_matrix %>%
  head() %>%
  kbl() %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE,
                position = "center")

1	2	3	4	5	6	7	8	9	10
47	0	0	0	0	1	1	3	1	1
0	24	0	0	0	0	0	0	0	0
1	2	28	0	1	0	0	0	0	3
4	2	3	64	2	10	2	9	3	4
24	12	16	31	82	30	19	10	17	31
12	1	2	2	11	61	2	18	6	2

On affiche l’accuracy de modèle :

accuracy %>%
  head() %>%
  kbl() %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE,
                position = "center")

x
0.5265306

On passe maintenant à la vérification de notre modèle mais d’abord on vérifie la répartition des domaines pour essayer de comprendre notre matrice de confusion.

library(ggplot2)

ggplot(train_data, aes(x = Code_domain)) +
  geom_bar() +
  labs(title = "Code_domain dans train_data", x = "Code_domain", y = "Nombre")

ggplot(test_data, aes(x = Code_domain)) +
  geom_bar() +
  labs(title = "Code_domain dans train_data", x = "Code_domain", y = "Nombre")

Utilsation de GridSearch pour vérifier la meilleure version du modèle (https://search.r-project.org/CRAN/refmans/NMOF/html/gridSearch.html)

Installer le package suivant si il n’est pas présent.

#install.packages("NMOF")

La librairie NMOF est utile car elle offre des outils pour résoudre des prblèmes doptimisation, d’allocation de ressources, …

library(NMOF)

## Warning: le package 'NMOF' a été compilé avec la version R 4.3.2

objective_function <- function(smoothing, ...) {
  bayes_modelGrid <- naiveBayes(Code_domain ~ ., data = train_data, laplace = smoothing)
  predictions <- predict(bayes_modelGrid, newdata = test_data)
  accuracy <- sum(predictions == test_data$Code_domain) / nrow(test_data)
  
  return(-accuracy)  
}

levels <- levels(train_data$Code_domain)

result <- gridSearch(fun = objective_function,lower =1,upper = 10, n = 10)

## 1 variables with 10 levels: 10 function evaluations required.

print(result)

## $minfun
## [1] -0.5265306
## 
## $minlevels
## [1] 1
## 
## $values
##  [1] -0.5265306 -0.5265306 -0.5265306 -0.5265306 -0.5265306 -0.5265306 -0.5265306 -0.5265306 -0.5265306 -0.5265306
## 
## $levels
## $levels[[1]]
## [1] 1
## 
## $levels[[2]]
## [1] 2
## 
## $levels[[3]]
## [1] 3
## 
## $levels[[4]]
## [1] 4
## 
## $levels[[5]]
## [1] 5
## 
## $levels[[6]]
## [1] 6
## 
## $levels[[7]]
## [1] 7
## 
## $levels[[8]]
## [1] 8
## 
## $levels[[9]]
## [1] 9
## 
## $levels[[10]]
## [1] 10

On remarque ici que cela ne change absolument rien, presque à ce demander si cela marche vraiment. On a pu lire à plusieurs endroits que le Naive Bayes n’avait pas assez de paramètre pour que le gridSearch soit efficace, c’est peut-être pour cela que l’on trouve la même chose que le modèle de base. Nous allons donc essayer une autre approche du grid search, cette fois combinée avec la cross validation directement.

library(e1071)

laplace_values <- seq(0, 3, by = 0.1)

results <- data.frame(laplace = laplace_values, accuracy = numeric(length(laplace_values)))

for (i in seq_along(laplace_values)) {
  bayes_model <- naiveBayes(Code_domain ~ ., data = train_data, laplace = laplace_values[i])
  predictions <- predict(bayes_model, newdata = test_data)

  confusion_matrix <- table(predictions, test_data$Code_domain)
  accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)
  results$accuracy[i] <- accuracy
}

print(results)

##    laplace  accuracy
## 1      0.0 0.5265306
## 2      0.1 0.5265306
## 3      0.2 0.5265306
## 4      0.3 0.5265306
## 5      0.4 0.5265306
## 6      0.5 0.5265306
## 7      0.6 0.5265306
## 8      0.7 0.5265306
## 9      0.8 0.5265306
## 10     0.9 0.5265306
## 11     1.0 0.5265306
## 12     1.1 0.5265306
## 13     1.2 0.5265306
## 14     1.3 0.5265306
## 15     1.4 0.5265306
## 16     1.5 0.5265306
## 17     1.6 0.5265306
## 18     1.7 0.5265306
## 19     1.8 0.5265306
## 20     1.9 0.5265306
## 21     2.0 0.5265306
## 22     2.1 0.5265306
## 23     2.2 0.5265306
## 24     2.3 0.5265306
## 25     2.4 0.5265306
## 26     2.5 0.5265306
## 27     2.6 0.5265306
## 28     2.7 0.5265306
## 29     2.8 0.5265306
## 30     2.9 0.5265306
## 31     3.0 0.5265306

Après ces deux essaies il est bon de conclure que nous avons déjà la meilleure version de notre modèle. On va maintenant pouvoir reprendre les prédictions de notre modèle et vérifier toutes les données métriques.

true_positive <- diag(confusion_matrix)
false_positive <- colSums(confusion_matrix) - true_positive
false_negative <- rowSums(confusion_matrix) - true_positive

accuracy <- sum(true_positive) / sum(confusion_matrix)
precision <- true_positive / (true_positive + false_positive)
recall <- true_positive / (true_positive + false_negative)
f1_score <- 2 * (precision * recall) / (precision + recall)

cat("Accuracy:", accuracy, "\n")

## Accuracy: 0.5265306

cat("Precision:", precision, "\n")

## Precision: 0.4795918 0.5217391 0.56 0.627451 0.7321429 0.5754717 0.3809524 0.3387097 0.4528302 0.3125

cat("Recall:", recall, "\n")

## Recall: 0.8703704 1 0.8 0.6213592 0.3014706 0.5213675 0.5517241 0.5384615 0.7058824 0.7142857

cat("F1-score:", f1_score, "\n")

## F1-score: 0.6184211 0.6857143 0.6588235 0.6243902 0.4270833 0.5470852 0.4507042 0.4158416 0.5517241 0.4347826

bayes_model

## 
## Naive Bayes Classifier for Discrete Predictors
## 
## Call:
## naiveBayes.default(x = X, y = Y, laplace = laplace)
## 
## A-priori probabilities:
## Y
##          1          2          3          4          5          6          7          8          9         10 
## 0.09771876 0.06060606 0.07728975 0.15083418 0.19169220 0.14674838 0.06401090 0.06843718 0.07048008 0.07218250 
## 
## Conditional probabilities:
##     distri_rubrique
## Y         [,1]     [,2]
##   1  11.160279 5.594899
##   2   8.337079 5.970632
##   3   9.903084 5.942150
##   4  10.844244 5.749337
##   5  11.840142 5.986285
##   6  10.679814 5.519061
##   7   9.579787 5.685991
##   8   9.860697 5.693900
##   9  10.685990 5.597585
##   10  9.537736 5.811697
## 
##     LD1
## Y          [,1]      [,2]
##   1  -0.5941858 0.5956581
##   2  -0.9328086 0.7343174
##   3  -0.6368679 0.6252647
##   4  -0.8478016 0.6879941
##   5   2.0052145 1.8324534
##   6  -0.3930482 0.5364844
##   7   0.3718601 0.9065853
##   8  -0.3852545 0.5915244
##   9   0.4396659 0.9212366
##   10 -0.6124000 0.6211559
## 
##     LD2
## Y          [,1]      [,2]
##   1  -1.0451786 1.0307525
##   2   2.2992754 2.0656853
##   3   1.6607598 1.6235873
##   4  -0.4949877 0.6967667
##   5   0.1761009 0.6247465
##   6  -0.7234943 0.7905426
##   7   0.2870975 0.8182327
##   8  -0.6699299 0.7671791
##   9  -0.4956512 0.6645030
##   10  0.8003526 1.0767249
## 
##     LD3
## Y           [,1]      [,2]
##   1  -0.49898384 0.6859674
##   2  -1.88382463 2.3008060
##   3   1.82153901 2.1994490
##   4   0.53975847 0.6766263
##   5   0.04564870 0.5088674
##   6  -0.21778168 0.4707725
##   7  -0.04893991 0.8820056
##   8  -0.06765607 0.5016017
##   9  -0.22941444 0.4643989
##   10 -0.09283553 0.9170013
## 
##     LD4
## Y           [,1]      [,2]
##   1  -0.97518144 1.2544084
##   2   0.30976074 0.7403951
##   3  -1.03655297 1.3993110
##   4   1.37797939 1.4951670
##   5   0.22219004 0.6624303
##   6  -0.33150639 0.7787444
##   7   0.03268638 0.6222588
##   8  -0.05971846 0.9205036
##   9  -0.68826151 0.8354220
##   10  0.21396346 0.7322327
## 
##     LD5
## Y           [,1]      [,2]
##   1  -0.22934885 0.5906377
##   2  -0.62922612 1.3192288
##   3  -0.41849497 0.9127678
##   4  -0.18412895 0.5826194
##   5  -0.36675730 0.9202897
##   6  -0.32610975 0.6322823
##   7   1.73217695 2.0242866
##   8  -0.08035213 0.5577598
##   9   0.52333446 0.8534901
##   10  1.38106631 1.5926970
## 
##     LD6
## Y           [,1]      [,2]
##   1  -1.14495068 1.6653515
##   2   0.23707128 0.6450022
##   3   0.06010169 0.4270536
##   4  -0.04605725 0.6280823
##   5  -0.28102588 0.9109071
##   6   0.53098241 0.9193279
##   7   0.20090470 0.7437620
##   8   0.45522600 0.8551421
##   9   1.34858599 1.6322488
##   10 -0.85876849 1.0040389
## 
##     LD7
## Y          [,1]      [,2]
##   1  -0.5967749 1.2174865
##   2  -0.3454594 0.8821814
##   3  -0.1570423 0.6996354
##   4  -0.3879328 0.7684666
##   5   0.1116828 0.6712070
##   6   0.8758582 1.1636638
##   7  -0.6720667 1.0393691
##   8   0.1746773 0.7964608
##   9  -0.7696714 1.2113915
##   10  1.2221309 1.6050087
## 
##     LD8
## Y            [,1]      [,2]
##   1  -0.005581538 0.5852935
##   2   0.091031877 0.6729002
##   3   0.080823220 0.6514614
##   4  -0.096995956 0.5226292
##   5  -0.055766738 0.8431918
##   6   0.448999227 0.7850346
##   7   1.502313272 2.0708178
##   8   0.045941945 0.6483776
##   9  -1.193446771 1.6417298
##   10 -0.960740268 1.4494876
## 
##     LD9
## Y             [,1]      [,2]
##   1   0.1149930569 0.8158112
##   2   0.0155218862 0.4437405
##   3  -0.0078370348 0.5802760
##   4   0.1391709667 0.8648649
##   5  -0.0295430586 0.5946001
##   6   0.3677139213 1.3299010
##   7  -0.0009921626 0.8125535
##   8  -1.3419557575 1.9306655
##   9   0.1781068487 1.0980882
##   10  0.0018341400 0.5293803

Encore une fois, nous nous rendons compte à quel point il est difficile d’obtenir une accuracy exceptionnelle. Au début de l’unitée nous pensions qu’il serait possible d’aller chercher des accuracy de plus de 95%. Comme ce dont on avait été habitué dans d’autres matières alors que pas du tout. On se rend compte que les données textuelles sont extrêmement difficiles à manipuler. Il faut faire des prétraitements précis et essayer de penser à tous les cas de figure. Ce qui est assez difficile.

1	2	3	4	5	6	7	8	9	10
47	0	0	0	0	1	1	3	1	1
0	24	0	0	0	0	0	0	0	0
1	2	28	0	1	0	0	0	0	3
4	2	3	64	2	10	2	9	3	4
24	12	16	31	82	30	19	10	17	31
12	1	2	2	11	61	2	18	6	2

1	2	3	4	5	6	7	8	9	10
47	0	0	0	0	1	1	3	1	1
0	24	0	0	0	0	0	0	0	0
1	2	28	0	1	0	0	0	0	3
4	2	3	64	2	10	2	9	3	4
24	12	16	31	82	30	19	10	17	31
12	1	2	2	11	61	2	18	6	2

1	2	3	4	5	6	7	8	9	10
47	0	0	0	0	1	1	3	1	1
0	24	0	0	0	0	0	0	0	0
1	2	28	0	1	0	0	0	0	3
4	2	3	64	2	10	2	9	3	4
24	12	16	31	82	30	19	10	17	31
12	1	2	2	11	61	2	18	6	2